home *** CD-ROM | disk | FTP | other *** search
/ MACD 5 / MACD 5.bin / workbench / blankery / blitzblank / sources / bb.crumble < prev    next >
Text File  |  1993-09-17  |  5KB  |  252 lines
  1. ;BB.Crumble - Blanker-module for BlitzBlank
  2. ;Copyright 1993 by Thomas Boerkel
  3.  
  4. CloseEd
  5. NoCli
  6.  
  7. NEWTYPE.table
  8. r.l
  9. g.l
  10. b.l
  11. End NEWTYPE
  12.  
  13. NEWTYPE.tags
  14. a.l
  15. b
  16. c
  17. d
  18. e
  19. f
  20. End NEWTYPE
  21.  
  22. DEFTYPE.Screen *fs,*myscreen
  23. DEFTYPE.ViewPort *vp
  24. DEFTYPE.RastPort *rp
  25. DEFTYPE.ColorMap *cm
  26. DEFTYPE.NewScreen newscreen
  27. DEFTYPE.Message *msg
  28. DEFTYPE.table tab
  29. DEFTYPE.MsgPort *port
  30. DEFTYPE.tags tags
  31. DEFTYPE.l
  32.  
  33. Statement stringborder{x,y,w,h}
  34. Wline x+1,y+h+2,x+1,y,x+w+8,y,1
  35. Wline x+w+10,y-1,x+w+10,y+h+4,x-1,y+h+4,1
  36. Wline x,y+h+3,x,y,1
  37. Wline x+w+11,y-1,x+w+11,y+h+4,1
  38. Wline x-1,y+h+3,x-1,y-1,x+w+10,y-1,2
  39. Wline x+w+9,y,x+w+9,y+h+3,x+1,y+h+3,2
  40. Wline x-2,y+h+4,x-2,y-1,2
  41. Wline x+w+8,y+1,x+w+8,y+h+2,2
  42. End Statement
  43.  
  44. Select Par$(1)
  45.   Case "BLANK"
  46.     name$="BB.BlankModule"+Chr$(0)
  47.     *port=CreateMsgPort_()
  48.     *port\mp_Node\ln_Name=&name$
  49.     *port\mp_Node\ln_Pri=1
  50.     AddPort_ *port
  51.     SetTaskPri_ FindTask_(0),Val(Par$(8))
  52.     Gosub readconfig
  53.     speed+30
  54.     lib$="intuition.library"+Chr$(0)
  55.     *ibase.IntuitionBase=OpenLibrary_(&lib$,39)
  56.     CloseLibrary_(*ibase)
  57.  
  58.     If *ibase
  59.       v39=1
  60.     Else
  61.       *ibase.IntuitionBase=OpenLibrary_(&lib$,37)
  62.       CloseLibrary_(*ibase)
  63.     EndIf
  64.  
  65.     *fs=*ibase\FirstScreen
  66.  
  67.     left=*fs\LeftEdge
  68.     top=*fs\TopEdge
  69.     width=*fs\Width
  70.     height=*fs\Height
  71.     modeid=GetVPModeID_(*fs\ViewPort)
  72.  
  73.     depth=*fs\BitMap\Depth
  74.  
  75.     title$="BB.Crumble.Screen"+Chr$(0)
  76.     newscreen\LeftEdge=left,top,width,height,depth
  77.     newscreen\ViewModes=0,#CUSTOMSCREEN|#SCREENBEHIND,0,&title$
  78.     tags\a=#SA_DisplayID
  79.     tags\b=modeid
  80.     tags\c=0
  81.     *myscreen=OpenScreenTagList_(newscreen,tags)
  82.     If *myscreen
  83.       *vp=*myscreen\ViewPort
  84.       *rp=*myscreen\RastPort
  85.       *bm=*rp\BitMap
  86.  
  87.       *cm=*fs\ViewPort\ColorMap
  88.       For i=0 To 2^depth
  89.         If v39
  90.           GetRGB32_ *cm,i,1,tab
  91.           SetRGB32_ *vp,i,tab\r,tab\g,tab\b
  92.         Else
  93.           c=GetRGB4_(*cm,i)
  94.           SetRGB4_ *vp,i,(c LSR 8) AND 15,(c LSR 4) AND 15,c AND 15
  95.         EndIf
  96.       Next i
  97.       Dim top(width)
  98.       Dim bot(width)
  99.       Gosub setup
  100.       ScreenToFront_ *myscreen
  101.  
  102.       Repeat
  103.         VWait 2
  104.         For i=1 To speed
  105.           x=Rnd(width)
  106.           If top(x)>=0
  107.             Repeat
  108.               c=ReadPixel_(*rp,x,top(x))
  109.               top(x)-1
  110.             Until c<>0 OR top(x)=-1
  111.             If top(x)=-1 AND c=0
  112.               a+1
  113.             Else
  114.               top(x)+1
  115.             EndIf
  116.             If c
  117.               SetAPen_ *rp,0
  118.               WritePixel_ *rp,x,top(x)
  119.               If Rnd(2)<1
  120.                 bot(x)-1
  121.                 SetAPen_ *rp,c
  122.                 WritePixel_ *rp,x,bot(x)
  123.               EndIf
  124.             Else
  125.               If a=width
  126.                 Gosub setup
  127.               EndIf
  128.             EndIf
  129.           EndIf
  130.         Next i
  131.         *msg=GetMsg_(*port)
  132.       Until *msg
  133.  
  134.       CloseScreen_ *myscreen
  135.     EndIf
  136.     RemPort_ *port
  137.     DeleteMsgPort_ *port
  138.  
  139.   Case "INFO"
  140.     title$="Crumble"+Chr$(0)
  141.     reqtext$="Crumble - Module for BlitzBlank"+Chr$(10)
  142.     reqtext$+Chr$(169)+" 1993 by Thomas Brkel"+Chr$(10)+Chr$(10)
  143.     reqtext$+"Your actual screen will be crumbled."+Chr$(10)+Chr$(10)
  144.     reqtext$+"Choose the speed in the config-window."+Chr$(0)
  145.     gadget$="OK"+Chr$(0)
  146.     easy.EasyStruct\es_StructSize=SizeOf.EasyStruct
  147.     easy\es_Title=&title$
  148.     easy\es_TextFormat=&reqtext$
  149.     easy\es_GadgetFormat=&gadget$
  150.     EasyRequestArgs_ 0,easy,0,0
  151.   Case "CONFIG"
  152.     *myscreen=LockPubScreen_(0)
  153.     width=*myscreen\Width
  154.     height=*myscreen\Height
  155.     font=*myscreen\Font\ta_YSize
  156.     Gosub readconfig
  157.     WbToScreen 0
  158.     BorderPens 0,0
  159.     StringGadget 0,100,25,0,0,4,40
  160.     SetString 0,0,Str$(speed)
  161.     Window 0,width/2-90,height/2-25,180,50,$100e,"Crumble",1,2,0
  162.     stringborder{100,25,40,8}
  163.     WColour 2
  164.     WLocate 30,24-font
  165.     Print "Speed:"
  166.     WLocate 30,24-font+8
  167.     Print "(1-100)"
  168.     ActivateString 0,0
  169.     Repeat
  170.       ev=WaitEvent
  171.     Until ev=$200 OR ev=$40
  172.     speed=Val(StringText$(0,0))
  173.     Free Window 0
  174.     Gosub writeconfig
  175.     UnlockPubScreen_ 0,*myscreen
  176. End Select
  177.  
  178. End
  179.  
  180. .readconfig
  181. path$=Par$(9)
  182. For i=10 To NumPars
  183.   path$=path$+" "+Par$(i)
  184. Next i
  185. If ReadFile(0,path$+"BB.Modules.config")
  186.   FileInput 0
  187.   While NOT Eof(0)
  188.     If Edit$(100)="*** Crumble ***"
  189.       speed=Val(Edit$(5))
  190.     EndIf
  191.   Wend
  192.   DefaultInput
  193.   CloseFile 0
  194. EndIf
  195. Gosub checkval
  196. Return
  197.  
  198.  
  199. .writeconfig
  200. Gosub checkval
  201. If ReadFile(0,path$+"BB.Modules.config")
  202.   If WriteFile(1,path$+"BB.Modules.temp")
  203.     FileInput 0
  204.     FileOutput 1
  205.     While NOT Eof(0)
  206.       f$=Edit$(100)
  207.       If f$="*** Crumble ***"
  208.         Repeat
  209.           f2$=Edit$(100)
  210.         Until Eof(0) OR Left$(f2$,3)="***"
  211.         If NOT Eof(0) Then NPrint f2$
  212.       Else
  213.         NPrint f$
  214.       EndIf
  215.     Wend
  216.     CloseFile 1
  217.   EndIf
  218.   CloseFile 0
  219. EndIf
  220. KillFile path$+"BB.Modules.config"
  221. f$=path$+"BB.Modules.temp"+Chr$(0)
  222. f2$=path$+"BB.Modules.config"+Chr$(0)
  223. Rename_ &f$,&f2$
  224. If OpenFile(0,path$+"BB.Modules.config")
  225.   FileOutput 0
  226.   FileSeek 0,Lof(0)
  227.   NPrint "*** Crumble ***"
  228.   NPrint speed
  229.   CloseFile 0
  230. EndIf
  231. Return
  232.  
  233. .checkval
  234. If speed<1 Then speed=100
  235. If speed>100 Then speed=100
  236. Return
  237.  
  238. .setup
  239. a=0
  240. BltBitMap_ *fs\BitMap,0,0,*myscreen\BitMap,0,0,width,height,$C0,$FF,0
  241. SetAPen_ *rp,0
  242. Move_ *rp,0,height-1
  243. Draw_ *rp,width-1,height-1
  244. Move_ *rp,0,height-2
  245. Draw_ *rp,width-1,height-2
  246. For i=0 To width-1
  247.   top(i)=height-2
  248.   bot(i)=height
  249. Next i
  250. Return
  251.  
  252.